Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/jplay.zip/JPLAYIT.PAS

Pascal/Delphi Source File | 1990-07-05 | 5KB | 227 lines

UNIT JPlayit;

(***************************************************************************

.TPU unit for playing and displaying .MUZ files
          -Process .MUZ files using BINOBJ filename.MUZ filename.OBJ filename
          -Change names in file JPLAY.PAS
          -Julian Higgs 6-24-90
          -
****************************************************************************)




(*****************************************************)
(* Copyright (c) 1988 by Neil J. Rubenking           *)
(* Demonstrates how to play a PIANOMAN MUZ file from *)
(* Turbo Pascal version 4.0.  You may freely include *)
(* and distribute this Unit in your programs.        *)
(*                                                   *)
(* To use the Unit, first create a MUZ file using    *)
(* PIANOMAN.  Then call on the BINOBJ utility that   *)
(* comes with TP4 to turn the MUZ file into an OBJ   *)
(* file.  Finally, declare a TP4 Procedure as an     *)
(* EXTERNAL using that OBJ file.  Now you can call   *)
(* the Procedure PlayOBJ in this Unit.               *)
(*                                                   *)
(* See PLAYDEMO.PAS for demonstration.               *)
(*****************************************************)




(**********************)
(**)   INTERFACE    (**)
(**********************)
Uses CRT,GRAPH;
PROCEDURE PlayOBJ(
         P : Pointer; {Pointer to "fake External" procedure containing tune}
   KeyStop : Boolean; {If true, tune will stop when key is pressed.}
    VAR CH : char);   {^Returns pressed key if stopped.}




(**********************)
(**) IMPLEMENTATION (**)
(**********************)

TYPE
  FiledNote = RECORD
                O, NS : Byte;
                D : Word;
              END;
  NotePt = ^FiledNote;

VAR
  Oct_Val : ARRAY[0..8] OF Real;
  Freq_Val : ARRAY[1..12] OF Real;
  Num, Notec, Ynote, Ynote2, Xnote2 : word;



  FUNCTION int2str (L : Longint) : String;
  var S : String;
  BEGIN
    Str(L, S);
    int2str :=S;
  END;



  PROCEDURE Writeout (S : string);
  BEGIN
    outtextxy(505,35,S);
  END;




  PROCEDURE Set_Frequencies;
  VAR N : Byte;
  BEGIN
    Freq_Val[1] := 1;
    Freq_Val[2] := 1.0594630944;
    FOR N := 3 TO 12 DO
      Freq_Val[N] := Freq_Val[N - 1] * Freq_Val[2];
    Oct_Val[0] := 32.70319566;
    FOR N := 1 TO 8 DO
      Oct_Val[N] := Oct_Val[N - 1] * 2;
  END;





  PROCEDURE Pgrid;
  BEGIN
    setcolor(4);
    line(1,2  ,639,2);
    line(1,79 ,639,79 );
    line(1,179,639,179);
    line(1,279,639,279);
    line(1,379,639,379);
    line(1,479,639,479);
    line(1,1  ,1  ,479);
    line(200,1,200,479);
    line(400,1,400,479);
    line(600,1,600,479);
    line(639,1,639,479);
    setcolor(15);
    outtextxy(5,1,  '480>');
    outtextxy(5,76, '400>');
    outtextxy(5,176,'300>');
    outtextxy(5,276,'200>');
    outtextxy(5,376,'100>');
    outtextxy(5,470,'  0>');
    writeout('='+int2str(num));
  END;





  PROCEDURE Posnote;
  BEGIN
    Ynote2 := 480-(Round(Ynote/5));
    if Ynote2 < 0   then Ynote2 :=0;
    if Ynote2 > 479 then Ynote2 :=479;
    Xnote2 := Xnote2 + 1;
    if Xnote2 > 640 then
      BEGIN
        ClearDevice;
        Pgrid;
        setcolor(14);
        Xnote2 := 1;
      END;
      outTextxy(xnote2,ynote2,'.');
  END;





  PROCEDURE PlayOne(Octave, NoteStaccato : Byte; Duration : Integer);
  CONST
    factor : ARRAY[0..10] OF Real = (0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0);
  VAR
    Frequency : Real;
    Note, Staccato : Byte;   (*!*)
  BEGIN
    Note := NoteStaccato SHR 4;
    Staccato := NoteStaccato AND $F;
    IF Staccato > 10 THEN Staccato := 10;
    IF Staccato < 0 THEN Staccato := 0;
    IF Octave > 8 THEN Octave := 8;
    IF Octave < 1 THEN Octave := 1;
    CASE Note OF
      1..12 : BEGIN
                Frequency := Oct_Val[Octave] * Freq_Val[Note];
                Ynote := Round(Frequency);
                Posnote;
                Sound(Round(Frequency));
                Delay(Round(Duration * factor[10 - Staccato]));
                IF Duration > 0 THEN NoSound;
                Delay(Round(Duration * factor[Staccato]));
              END;
      13 : BEGIN NoSound; Delay(Duration); END;
    END;                     {case}
  END;






(****************************************************************************

               The callable object - rest is support routines              *)




  PROCEDURE PlayOBJ(P : Pointer; KeyStop : Boolean; VAR CH : char);

  VAR T : NotePt;
    N   : Word;

  BEGIN

    Xnote2 := 0;
    ClearDevice;
    SetColor(5);
    OutTextxy(435,20,'Jewltronics 1990');
    outtextxy(455,35,'note#=');
    pgrid;
    Setcolor(14);

    T := NotePt(P);
    Inc(LongInt(T), SizeOf(FiledNote) * 5);
    Num := LongInt(T^) AND $FFFF;
    Inc(LongInt(T), SizeOf(FiledNote) * 4);
    FOR N := 1 TO Num DO
      BEGIN
        WITH T^ DO
          PlayOne(O, NS, D);
        Inc(LongInt(T), SizeOf(FiledNote));
        IF KeyStop AND KeyPressed THEN
          BEGIN
            CH := ReadKey;
            Exit;
          END;
      END;
  END;






(**********************)
(*   INITIALIZATION   *)
(**********************)
BEGIN
  Set_Frequencies;
END.